#!/usr/bin/perl

#    Pete's VCR Chooser
#    Copyright (C) 2005 Peter Harris
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License version 2 as
#    published by the Free Software Foundation.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#    This program is currently hosted at http://code.google.com/p/vgapd/


use warnings;
use strict;

use Tk;

my $main = MainWindow->new();


# Main structure:
my $right = $main->Canvas;
my $list = $main->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'multiple');

$right->pack(-side => 'right', -fill => 'y');
$list->pack(-side => 'left', -fill => 'both', -expand => 1);
#With a bit of space in the middle
$main->Frame(-width => 10)->pack(-side => 'right');


# Buttons:
 # Buttons are anonymous. We just don't need their handles.
$right->Button( -text => 'Open...', -command => \&do_open )->pack(-fill => 'x');
$right->Button( -text => 'Save Selected...', -command => \&do_save )->pack(-fill => 'x');

  #gap:
$right->Frame(-height => 10)->pack;

$right->Button( -text => 'Select All', -command => \&do_sel )->pack(-fill => 'x');
$right->Button( -text => 'Deselect All', -command => \&do_desel )->pack(-fill => 'x');

$right->Button( -text => 'Quit', -command => sub { $main->destroy } )->pack(-fill => 'x', -side => 'bottom');


# List contents:
# foreach (1..50) {
#     $list->insert('end', 'button '.$_ );
# }
# 

MainLoop;


#Done. Helper functions:
my @vcr;
my $signature;

sub do_open {
    my $glob;

    my $file = $main->getOpenFile(-filetypes => [['VCR Files', '.DAT']]);
    return unless (defined $file);

    my $size = -s $file;
    goto invalid if ($size < 12);

    $size -= 12;
    goto invalid if ($size % 100);

	# Should maybe say "can't open" instead of "invalid file" here.
    open INFILE, $file or goto invalid;
    binmode INFILE;

    read INFILE, $glob, 2;
    my $count = unpack 'v', $glob;
    goto invalid if ($count != $size / 100);
    
    undef @vcr;
    $list->delete(0, $list->size - 1);
    for (my $i=0; $i<$count; $i++) {
    	read INFILE, $vcr[$i], 100;

	my $name;
	$name = unpack ('x12A20', $vcr[$i]);
	$name .= ' vs ';
	$name .= unpack ('x54A20', $vcr[$i]);
	$list->insert('end', $name);
    }
    read INFILE, $signature, 10;
    close INFILE;

    return;

invalid:
    $main->messageBox(-icon => 'error',
		-message => "$file is not a valid VCR file",
		-title => 'Fatal Error',
		-type => 'Ok' );
    return;
}

sub do_save {
    my $file = $main->getSaveFile(-filetypes => [['VCR Files', '.DAT']]);

    open OUTFILE, ">$file" or goto invalid;
    binmode OUTFILE;

    my @list = $list->curselection;

    syswrite OUTFILE, pack('v', scalar @list), 2;

    my $first = 1;
    my $seed;
    my $zero;
    my $glob;

    foreach (@list) {
    	($seed, $zero, $glob) = unpack ('vva98', $vcr[$_]);
	if ($first) {
	    $zero = 48879 - $seed;
	    $first = 0;
	} else {
	    $zero = 0;
	}
	syswrite OUTFILE, pack('vva98', $seed, $zero, $glob), 100;
    }

    syswrite OUTFILE, $signature, 10;
    close OUTFILE;

    return;

invalid:
    $main->messageBox(-icon => 'error',
		-message => "Cannot open $file for writing",
		-title => 'Fatal Error',
		-type => 'Ok' );
    return;
}

sub do_sel {
    $list->selectionSet(0, $list->size - 1);
}

sub do_desel {
    $list->selectionClear(0, $list->size - 1);
}
